home *** CD-ROM | disk | FTP | other *** search
/ Aminet 21 / Aminet 21 (1997)(GTI - Schatztruhe)[!][Oct 1997].iso / Aminet / comm / mail / YAMscripts.lha / MakeDigest.rexx < prev    next >
OS/2 REXX Batch file  |  1997-06-22  |  6KB  |  264 lines
  1. /* MakeDigest.rexx v 1.1 22-Jun-97 by Kai Nikulainen
  2. **
  3. ** Q: What does it do?  
  4. ** A: Joins several messages into one which can for example be searched 
  5. **    by YAMtools.  Anyway it makes the folder look cleaner...
  6. **
  7. ** Q: Which messages are added?  
  8. ** A: All which match given subject pattern.  * can be used as a wildcard.
  9. **
  10. ** Q: What happened to the attachments?
  11. ** A: They are still there, YAM just doesn't see them anymore.  You need to
  12. **    use some other program, for example mpack to extract them.
  13. **
  14. ** Q: How many gorillas does it take to screw in a light bulb?
  15. ** A: Only one, but it sure takes a shitload of light bulbs!
  16. **
  17. ** If you have any problems, mail me at knikulai@utu.fi
  18. */
  19. options results
  20. call addlib('rexxreqtools.library',0,-30,0)
  21.  
  22. addrheader='To'        /* Must be 'from' or 'to'.  Decides which field is used */
  23.             /* for the default sender address for the digest */ 
  24. defper=14        /* Default period for date selection*/
  25. headers=7        /* ONLY these headers are copied to the digest */
  26. hdr.1='Reply-To:'    /* If you add or remove headers, remember to   */
  27. hdr.2='To:'        /* change variable headers to a correct value! */
  28. hdr.3='Date:'
  29. hdr.4='Subject:'
  30. hdr.5='From:'
  31. hdr.6='Content-Type:'
  32. hdr.7='Sender:'
  33. months='Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec'
  34. temp='t:digest.tmp'
  35. timezone='+0000'
  36. receiver='be or not to be'
  37. separator='----*---- ----*---- ----*---- ----*---- ----*---- ----*---- ----*---- '
  38. /* Separator is added between messages.  If it's empty, nothing is written. */
  39.  
  40.  
  41. copy='c:copy'
  42. delete='c:delete'
  43.  
  44. /* These texts are for the subject pattern entry field */
  45.   ptxt='Enter search pattern for subjects?'
  46. ptitle='Select messages which will be combined'
  47.  pbuts='_Ok|_Exit script'
  48.  
  49. /* Subject entry gadget */
  50.   stxt='Enter subject for the digest?'
  51. stitle='Message subject'
  52.  sbuts='_Ok|_Exit script'
  53.  
  54. /* Dates */
  55.   dtxt='What should be the first date to join?'
  56.   etxt='How many days of messages should be joined?'
  57. dtitle='Set selection criteria'
  58.  dbuts='_Ok|_Exit script' 
  59.  
  60. /* Search criteria selection */
  61.   qtxt='How do you want to select messages?'
  62. qtitle='Selection criteria'
  63.  qbuts='By _Date|By _Subject|_Exit script'
  64.  
  65. /* Range confirmation */
  66.   ctxt='Starting to combine messages from' || '0a'x
  67. ctitle='Confirm range'
  68.  cbuts='_Correct|_Wrong range|_Exit script'
  69.  
  70. /* From header */
  71.   ftxt='Who should the sender of the digest?'
  72. ftitle='Set digest header'
  73.  fbuts='_Ok|_Exit script'
  74.  
  75. /* this is common for all reqtools requesters */
  76.  tags=''
  77.  
  78.  
  79. if ~open(1,temp,'w') then do
  80.     'Request "Could not write' temp'" "_Quit"'
  81.     exit
  82.     end
  83.  
  84. address 'YAM'
  85. 'GetFolderInfo Name'
  86. subj=result 'digest' 
  87.  
  88. AddHeaders=1
  89.  
  90. 'GetFolderInfo Max'     /* How many messages are there? */
  91. n=result
  92.  
  93. 'GetMailInfo Subject'
  94. str=result
  95. if left(upper(str),3)='RE:' then str=substr(str,4)
  96.  
  97. 'GetMailInfo Active'
  98. act=result
  99. if rc>0 then do
  100.     str='*'
  101.     curname=''
  102.     end
  103. else do
  104.     str='*'str'*'
  105.     'GetMailInfo file'
  106.     curname=result
  107.     end
  108. str=strip(str)
  109.  
  110. maximum=0
  111. 'SetMail 0' 
  112. 'GetMailInfo file'
  113. name=result
  114. if curname='' then curname=name
  115. p1=lastpos(':',name)
  116. p2=lastpos('/',name)
  117. p=max(p1,p2)+1
  118.  
  119. cri=rtezrequest(qtxt,qbuts,qtitle,tags)
  120. if cri=0 then exit
  121.  
  122. if cri=2 then do
  123.     pattern=upper(rtgetstring(str,ptxt,ptitle,pbuts,tags))
  124.     if pattern='' then exit
  125.     subj=subj date()
  126.     end
  127. else do
  128.     firstd=GetDate(curname)
  129.     do until sel=1
  130.         ds=rtgetstring(date('n',firstd),dtxt,dtitle,dbuts,tags)
  131.         if ds='' then exit
  132.         parse var ds day month year
  133.         mo=right('0' || 1+(pos(month,months)-1)/4,2)
  134.         da=right('0' || day,2)
  135.         ye=right('19' || year,4)
  136.         firstd=date('i',ye || mo || da,'S')
  137.         delta=rtgetstring(defper,etxt,dtitle,dbuts,tags)
  138.         if delta='' then exit
  139.         if datatype(delta)~='NUM' then delta=0
  140.         lastd=firstd+delta-1
  141.         fstr=date('n',firstd)
  142.         lstr=date('n',lastd)
  143.         sel=rtezrequest(ctxt || fstr 'to' lstr,cbuts,ctitle,tags)
  144.         if sel=0 then exit
  145.         end
  146.     subj=subj ' ' fstr '-' lstr
  147.     end
  148.  
  149. subj=rtgetstring(subj,stxt,stitle,sbuts,tags)
  150. if subj='' then exit
  151. call writeln(1,'Subject:' subj)
  152. call writeln(1,'To:' receiver)
  153.     
  154. do m=0 to n-1
  155.     'SetMail' m
  156.     'GetMailInfo file'
  157.     fname=result
  158.     d=GetDate(fname)
  159.     if cri=2 then do /* get the subject */
  160.         'GetMailInfo Subject'
  161.         subj=result
  162.         end
  163.     if maximum<substr(fname,p) then maximum=substr(fname,p)
  164.     if (match(pattern,subj) & cri=2) | (d>=firstd & d<=lastd & cri=1) then do
  165.         if AddHeaders then do
  166.             'GetMailInfo' addrheader
  167.             fr=rtgetstring(result,ftxt,ftitle,fbuts,tags)
  168.             if fr='' then exit
  169.             call writeln(1,'From:' fr)
  170.             call writeln(1,RememberDate)
  171.             call writeln(1,'')
  172.             AddHeaders=0
  173.             end
  174.         call CopyMsg(fname)
  175.         if separator~='' then call writeln(1,separator)
  176.         'MailDelete'
  177.         end
  178.     end
  179.  
  180. q=lastpos('.',maximum)
  181. ext=right('00'substr(maximum,q+1)+1,3)
  182. newname=left(fname,p-1) || left(maximum,q) || ext
  183. call close(1)
  184.  
  185. address command copy temp newname
  186. address command delete temp
  187.  
  188. 'MailUpdate'
  189. 'SetMail' act
  190. exit    /* Welcome to the edge of the world */
  191.  
  192. GetDate: 
  193. parse arg fn
  194.     res=0
  195.     r=''
  196.     call open(2,fn,'r')
  197.     do until eof(2) | r='' | word(r,1)='Date:'
  198.          r=translate(readln(2),' ','09'x)
  199.         end
  200.     call close(2)
  201.     if word(r,1)='Date:' then do
  202.         RememberDate=r
  203.         if pos(',',r)=0 then
  204.             parse var r 'Date:' day month year .
  205.         else
  206.             parse var r 'Date:' wd',' day month year .
  207.         mn=right('0' || 1+(pos(month,months)-1)/4,2)
  208.         da=right('0' || day,2)
  209.         ye=right('19' || year,4)
  210.         res=date('i',ye || mn || da,'S')
  211.         end
  212. return res
  213.  
  214. CopyMsg:
  215. parse arg fn
  216.     call open(2,fn,'r')
  217.     do until r=''
  218.         r=readln(2)
  219.         w=word(translate(r,' ','09'x),1)
  220.         do i=1 to headers
  221.             if w=hdr.i then call writeln(1,r)
  222.             end
  223.         end
  224.     do until eof(2)
  225.         call writeln(1,r)
  226.         r=readln(2)
  227.         end
  228.     call close(2)
  229. return
  230.  
  231. Match: procedure
  232. parse arg pat,str
  233.     res=0
  234.     pat=upper(pat)
  235.     str=upper(str)
  236.     p1=pos('*',pat)
  237.     if p1=0 then
  238.         res=(pat=str)
  239.     else do
  240.         alku=left(pat,p1-1)    /* chars before first * */
  241.         ale=length(alku)
  242.         p2=lastpos('*',pat)
  243.         if left(str,ale)~=alku then
  244.             res=0
  245.         else 
  246.             if p1=length(pat) then 
  247.                 res=1
  248.             else do
  249.                 loppu=substr(pat,p1+1)
  250.                 p2=pos('*',loppu)
  251.                 if p2=0 then
  252.                     res=(right(str,length(loppu))=loppu)
  253.                 else do
  254.                     seur=left(loppu,p2-1)
  255.                     i=ale
  256.                     do while pos(seur,str,i+1)>0
  257.                         i=pos(seur,str,i+1)
  258.                         res=(res | Match(loppu,substr(str,i)))
  259.                         end
  260.                     end
  261.                 end /* else do */    
  262.             end
  263. return res
  264.